home *** CD-ROM | disk | FTP | other *** search
/ The Kara Collection / Kara Collection v3.0 (1996-09-12)(Cloanto).iso / utilities / h / 0 / 6 / 2 / rexx / processfont.ctrx < prev    next >
Text File  |  1996-06-01  |  5KB  |  229 lines
  1. /* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: ProcessFont.ctrx 1.1 */
  4.  
  5. /**
  6.  This script transforms the current font (which should be a black & white
  7.  font) into a "risen" or "embossed" color font. The script uses
  8.  Personal Paint for image processing, and shows how the two programs
  9.  can interact.
  10.  
  11.  Each character is passed by ColorType to Personal Paint for processing.
  12.  Depending on the options, either the "Rise High" or "Emboss Low" filters
  13.  are applied, always followed by a "Blur Low".
  14. */
  15.  
  16. OPTIONS RESULTS
  17. OPTIONS FAILAT 10000
  18.  
  19. IF ARG(1, EXISTS) THEN DO
  20.     PARSE ARG CTPORT
  21.     /* started from application: can be stopped with <Shift-Esc> */
  22.     no_progress = 'NOPROGRESS'
  23. END
  24. ELSE DO
  25.     CTPORT = 'COLORTYPE'
  26.     /* started from Workbench: can be stopped using the progress requester "Stop" gadget */
  27.     no_progress = ' '
  28. END
  29.  
  30. PPPORT = 'PPAINT'
  31.  
  32. IF ~StartProg('ColorType', 'ColorType:ColorType', CTPORT, 1) THEN
  33.     EXIT 10
  34. IF ~StartProg('Personal Paint', 'PPaint:PPaint', PPPORT, 4) THEN
  35.     EXIT 11
  36.  
  37. SIGNAL ON Break_C
  38.  
  39. ADDRESS VALUE PPPORT
  40. LockGUI    /* Lock Personal Paint */
  41.  
  42. ADDRESS VALUE CTPORT
  43. LockGUI    /* Lock ColorType */
  44.  
  45. ScreenToFront
  46. Request '"Font Processing" "LIST = _Effect:, 2, 0, 20, 3, Rise, Emboss "'
  47. IF RC = 0 THEN DO
  48.     IF RESULT.1 = 0 THEN DO
  49.         proc_filt = 'Rise High'
  50.         gridpen = 5
  51.         plt_data = '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 CACACA92 9292FFFF FFAAAAAA 6D6D6D49 49492424 24000000'X
  52.     END
  53.     ELSE DO
  54.         proc_filt = 'Emboss Low'
  55.         gridpen = 3
  56.         plt_data = '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 CACACA00 00002424 24494949 6D6D6D92 9292AAAA AAFFFFFF'X
  57.     END
  58.  
  59.     GetChar
  60.     scnum = RESULT
  61.     SetChar FIRSTON
  62.     IF RC = 0 THEN DO
  63.         /* not an empty font */
  64.         errcode = 0
  65.         Get 'XMAX'
  66.         xmax = RESULT + 4
  67.         Get 'YMAX'
  68.         ymax = RESULT + 4
  69.  
  70.         Set 'FORCE "XMAX='xmax'" "YMAX='ymax'" "COLORS=8"'
  71.         IF RC = 0 THEN DO
  72.             /* Create a grayscale palette file */
  73.             tmpfname = 'T:ctrx_plt.'PRAGMA('ID')
  74.             IF OPEN(pltfile, tmpfname, 'W') THEN DO
  75.                 WRITECH(pltfile, plt_data)
  76.                 CALL CLOSE(pltfile)
  77.             END
  78.  
  79.             SetPen 'GRID 'gridpen' REMAP -1'
  80.  
  81.             ADDRESS VALUE PPPORT        /* Set Personal Paint environment */
  82.             DelFrames ALL
  83.             ClearImage
  84.             Set '"IMAGEW='xmax'" "IMAGEH='ymax'" "COLORS=8" "PALETTE=""'tmpfname'""" "SCREENW='xmax'" "SCREENH='ymax'"'
  85.             IF RC = 0 THEN DO
  86.                 xmax = xmax - 1
  87.                 ymax = ymax - 1
  88.                 ADDRESS VALUE CTPORT
  89.  
  90.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname'#?'
  91.                 tmpfname = 'T:ctrx_pic.'PRAGMA('ID')
  92.  
  93.                 DO FOREVER
  94.                     IsBlank
  95.                     IF RESULT = 0 THEN DO
  96.                         GetXSize
  97.                         xsize = RESULT
  98.                         GetSpace
  99.                         space = RESULT
  100.                         GetKern
  101.                         kern = RESULT
  102.  
  103.                         SaveImage no_progress 'FORCE FILE 'tmpfname' FORMAT ILBM'
  104.                         IF RC = 0 THEN DO
  105.  
  106.                             ADDRESS VALUE PPPORT        /* Personal Paint processing */
  107.  
  108.                             LoadBrush 'NOPROGRESS FORCE FILE 'tmpfname
  109.                             IF RC = 0 THEN DO
  110.                                 PaintMode REPLACE
  111.                                 SetBrushAttr HANDLEX 0 HANDLEY 0
  112.                                 xoffs = (xmax + 1 - xsize) % 2        /* allow extra space: the processing can "fatten" the character */
  113.                                 PutBrush xoffs 2
  114.                                 Process '"'proc_filt'"' 0 0 xmax ymax
  115.                                 Process '"Blur Low"' 0 0 xmax ymax
  116.                                 GetRectBrush 0 0 xmax ymax
  117.                                 ClearImage
  118.                                 SaveBrush 'NOPROGRESS FORCE FILE 'tmpfname' FORMAT ILBM'
  119.                                 FreeBrush 'FORCE'
  120.                             END
  121.  
  122.                             ADDRESS VALUE CTPORT        /* back to ColorType */
  123.  
  124.                             LoadImage no_progress 'FORCE NOSTRETCH FILE 'tmpfname
  125.                             IF RC = 0 THEN DO
  126.                                 Chop    /* remove unused extra space */
  127.                                 GetXSize
  128.                                 new_xsize = RESULT
  129.                                 space = space + (new_xsize - xsize)
  130.                                 SetSpace space
  131.                                 SetKern kern
  132.                             END
  133.                             ELSE DO
  134.                                 errcode = RC
  135.                                 IF RC = 5 THEN
  136.                                     errmess = 'User abort during load.'
  137.                                 ELSE
  138.                                     errmess = 'Error 'RC' during load.'
  139.                                 LEAVE
  140.                             END
  141.                         END
  142.                         ELSE DO
  143.                             errcode = RC
  144.                             IF RC = 5 THEN
  145.                                 errmess = 'User abort during save.'
  146.                             ELSE
  147.                                 errmess = 'Error 'RC' during save.'
  148.                             LEAVE
  149.                         END
  150.                     END
  151.                     SetChar NEXTON
  152.                     IF RC ~= 0 THEN
  153.                         LEAVE
  154.                 END
  155.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname'#?'
  156.             END
  157.             ELSE DO
  158.                 errcode = RC
  159.                 errmess = 'PPaint environment cannot be set:_error 'RC'.'
  160.             END
  161.         END
  162.         ELSE DO
  163.             errcode = RC
  164.             errmess = 'New font format cannot be set:_error 'RC'.'
  165.         END
  166.  
  167.         IF errcode > 0 THEN DO
  168.             SAY errmess
  169.             RequestNotify 'PROMPT="'errmess'"'
  170.         END
  171.     END
  172.     SetChar scnum
  173. END
  174. UnlockGUI
  175.  
  176. ADDRESS VALUE PPPORT
  177. UnlockGUI
  178.  
  179. EXIT 0
  180.  
  181.  
  182. StartProg:
  183.     prog_name  = ARG(1)
  184.     prog_fname = ARG(2)
  185.     prog_port  = ARG(3)
  186.     prog_rxver = ARG(4)
  187.  
  188.     IF ~SHOW('P', prog_port) THEN DO
  189.         IF EXISTS(prog_fname) THEN DO
  190.             ADDRESS COMMAND 'Run >NIL: "'prog_fname'"'
  191.             DO 30 WHILE ~SHOW('P',prog_port)
  192.                  ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  193.             END
  194.         END
  195.         ELSE DO
  196.             SAY prog_name' could not be loaded.'
  197.             RETURN 0
  198.         END
  199.     END
  200.  
  201.     IF ~SHOW('P', prog_port) THEN DO
  202.         SAY prog_name' Rexx port could not be opened.'
  203.         RETURN 0
  204.     END
  205.  
  206.     IF prog_rxver > 1 THEN DO
  207.         ADDRESS VALUE prog_port
  208.         Version 'REXX'
  209.         IF RESULT < prog_rxver THEN DO
  210.             errmess = 'This script requires a newer_version of 'prog_name'.'
  211.             SAY errmess
  212.             RequestNotify 'PROMPT="'errmess'"'
  213.             RETURN 0
  214.         END
  215.     END
  216.  
  217.     RETURN 1
  218.  
  219.  
  220. Break_C:
  221.  
  222.     ADDRESS VALUE CTPORT
  223.     UnlockGUI
  224.     ADDRESS VALUE PPPORT
  225.     UnlockGUI
  226.     SIGNAL OFF Break_C
  227.  
  228.     RETURN
  229.